Pensieve header: Plotting the eigenvalues of the Temperley-Lieb inner product.

SetAttributes[p, Orderless];
CLP[{}]={1};
CLP[l_List] := CLP[l] = Flatten[Table[
Flatten[Outer[Times, CLP[l[[2;;k-1]]], CLP[l[[k+1;;Length[l]]]]]]*p[l[[1]], l[[k]]],
{k,2, Length[l], 2}
]];
DrawPairing[P_] := Graphics[{
Line[{{0,0},{1+Max[Flatten[List@@P /. p->List]],0}}],
List@@P /. p[i_, j_] :> BezierCurve[{{i,0},{(i+j)/2, (j-i)/2}, {j,0}}]
}]

CLP[Range[8]]

DrawPairing /@ CLP[Range[6]]

CLP[Range[8]] // Length

Hom[n_, m_] := CLP[Join[-Range[n], Range[m]]]

Hom[3,5]

Hom[5,3]

Comp[p1_, p2_] := Module[
{t1,t2,t3},
t1=p1*(p2 /. p[a_, b_]:> p[If[a<0, -a, 100+a], If[b<0, -b, 100+b]]);
t2=t1 //. p[a_,b_]p[b_,c_] :> p[a,c];
t3= t2 /. {p[a_,a_]->δ, p[a_,b_]^2 -> δ};
t3 /. p[a_,b_] :> p[If[a>100, a-100,a], If[b>100,b-100,b]]
]

Comp[p[-3,3] p[-1,-2] p[1,2] p[4,5],p[-5,-4] p[-3,-2] p[-1,1] p[2,3]]

IP[p1_, p2_] := Module[
{t1,t2},
t2=(p1 p2)//. p[a_,b_]p[b_,c_] :> p[a,c];
t2 /. {p[a_,a_]->δ, p[a_,b_]^2 -> δ}
]

IP[p[-3,3] p[-1,-2] p[1,2] p[4,5],p[-5,-4] p[-3,-2] p[-1,1] p[2,3]]

M[n_] := Outer[IP, Hom[n,n], Hom[n,n]]

M[2] // MatrixForm

M[3] // MatrixForm

M[4] // MatrixForm

M[5] // MatrixForm

ColumnForm[StringJoin /@ (M[5] /. δ^k_. :> ToString[k]<>" ")]

Plot[Eigenvalues[M[3]], {δ,0,2}, PlotRange->{-1,1}]

Plot[Eigenvalues[M[4]], {δ,0,2}, PlotRange->{-1,1}]

Plot[Eigenvalues[M[5]], {δ,0,2}, PlotRange->{-1,1}/10]